home *** CD-ROM | disk | FTP | other *** search
Text File | 1994-05-08 | 5.0 KB | 221 lines | [TEXT/MSET] |
- \ Assembler ReeseWarner 3/85
- \ May 87 mrh rewritten to use code ParseToken for speed.
-
- 0 -> dlevel
-
- 0 value POS \ position on line
-
- 0 value LINECT
-
- 0 value STOREDTOKEN
-
- 0 value CHARCOUNT \ char in definition
-
- string TOKEN
-
-
- code CHARCLASS
-
- hex
- 0C00 w, 0020 w, \ CMPI.B #$20,DO ; blank
- 6f00 w, 008c w, \ BEQ cntrl
- 0c00 w, 0041 w, \ CMPI.B #$41,D0 ; A
- 6d18 w, \ BLT.S trydig
- 0c00 w, 005a w, \ CMPI.B #$5A,D0 ; Z
- 6F00 w, 0090 w, \ BLE maybe
- 0c00 w, 0061 w, \ CMPI.B #$61,D0 ; a
- 6d18 w, \ BLT.S tryspec
- 0c00 w, 007a w, \ CMPI.B #$7A,D0 ; z
- 6f00 w, 0082 w, \ BLE maybe
- 6070 w, \ BRA.S spec ; Everything above z
- \ ; is a special
-
- 0c00 w, 0030 w, \ trydig CMPI.B #$30,D0 ; 0
- 6d08 w, \ BLT.S tryspec
- 0c00 w, 0039 w, \ CMPI.B #$39,D0 ; 9
- 6f00 w, 006e w, \ BLE digit
- 0c00 w, 0028 w, \ tryspec CMPI.B #$28,D0 ; (
- 6760 w, \ BEQ.S letter
- 0c00 w, 0029 w, \ CMPI.B #$29,D0 ; )
- 675a w, \ BEQ.S letter
- 0c00 w, 0024 w, \ CMPI.B #$24,D0 ; $
- 6758 w, \ BEQ.S dollar
- 0c00 w, 002d w, \ CMPI.B #$2D,D0 ; -
- 6724 w, \ BEQ.S minus
- 0c00 w, 003b w, \ CMPI #$3B,D0 ; ;
- 6748 w, \ BEQ.S letter
- 0c00 w, 002b w, \ CMPI #$2B,D0 ; +
- 6748 w, \ BEQ.S digit
- 603c w, \ BRA.S spec
-
- \ *** The following is obsolete and unexecuted, but if I remove it
- \ it will take me weeks to fix up all the changed offsets!! ***
-
- 005d w, \ CMPI.B #$5D,D0 ; ]
- 6738 w, \ BEQ.S spec
- 0c00 w, 005b w, \ CMPI.B #$5B,D0 ; [
- 6732 w, \ BEQ.S spec
- 0c00 w, 0024 w, \ CMPI.B #$24,D0 ; $
- 6734 w, \ BEQ.S dollar
- 0c00 w, 002d w, \ CMPI.B #$2D,D0 ; -
- 662a w, \ BNE.S letter
-
- \ *** End of obsolete section.
-
- 1210 w, \ minus MOVE.B (A0),D1 ; Look at next char
- 0c01 w, 0028 w, \ CMPI.B #$28,D1 ; -(
- 6722 w, \ BEQ.S letter
- 2003 w, \ MOVE.L D3,D0 ; But if we're in a
- 4e75 w, \ RTS ; word, it's a spec,
- \ ; otherwise a digit.
-
- \ *** Another obsolete section.
-
- 6718 w, \ BEQ.S spec
- 0c01 w, 0044 w, \ CMPI.B #$44,D1 ; -D
- 6712 w, \ BEQ.S spec
- 0c01 w, 0064 w, \ CMPI.B #$64,D1 ; -d
- 670c w, \ BEQ.S spec
- 0c01 w, 0028 w, \ CMPI.B #$28,D1 ; -(
- 670a w, \ BEQ.S letter
- 600e w, \ BRA.S digit
-
- \ *** end of obsolete section.
-
- 7003 w, \ cntrl MOVEQ #3,D0
- 4e75 w, \ RTS
-
- 7002 w, \ spec MOVEQ #2,D0
- 4e75 w, \ RTS
-
- 7000 w, \ letter MOVEQ #0,D0
- 4e75 w, \ RTS
-
- 7401 w, \ dollar MOVEQ #1,D2
- 7001 w, \ digit MOVEQ #1,D0
- 4e75 w, \ end RTS
- 2002 w, \ maybe MOVE D2,D0 ; "Letter" may be digit
- 4e75 w, \ RTS ; if we're reading hex
-
- 0 w, \ Get offsets right!
-
- code PARSETOKEN
-
- 2C1E w, \ POP D6
- 6726 w, \ BEQ.S eol
- 5346 w, \ SUBQ.W #1,D6
- 7400 w, \ MOVEQ #0,D2
- 2056 w, \ MOVE (A6),A0
- 7601 w, \ MOVEQ #1,D3 ; Initially we want
- \ ; '-' to be a digit
- 1018 w, \ MOVE.B (A0)+,D0
- 0C00 w, 0020 w, \ bloop CMPI #$20,D0
- 52CE w, FFF8 w, \ DBHI D6,bloop
- 6F12 w, \ BLE.S eol
- 2248 w, \ MOVE A0,A1
- 6100 w, FF28 w, \ BSR dic[charclass]
- 4A40 w, \ TST.W D0
- 6716 w, \ BEQ.S word
- 5380 w, \ SUBQ #1,D0
- 672E w, \ BEQ.S number
- 7603 w, \ MOVEQ #3,D3
- 6046 w, \ BRA.S
-
- 4296 w, \ eol CLR (SP)
- 2d3C w, 4 , \ PUSH #4
- 42A6 w, \ CLR -(SP)
- 42A6 w, \ CLR -(SP)
- 6048 w, \ BRA.S end
-
- 7602 w, \ word MOVEQ #2,D3
- 5346 w, \ SUBQ.W #1,D6
- 6B30 w, \ BMI.S
- 1018 w, \ wdloop MOVE.B (A0)+,D0
- 6100 w, FF02 w, \ BSR dic[charclass]
- 4A40 w, \ TST.W D0
- 6702 w, \ BEQ.S wtest
- 5380 w, \ SUBQ #1,D0
- 56CE w, FFF2 w, \ wtest DBNE D6,wdloop
- 6016 w, \ BRA.S eoltst
- 0 w,
- 0 w,
- 7601 w, \ number MOVEQ #1,D3
- 5346 w, \ SUBQ.W #1,D6
- 6B14 w, \ BMI.S eol
- 1018 w, \ numloop MOVE.B (A0)+,D0
- 6100 w, FEE6 w, \ BSR dic[charclass]
- 5380 w, \ SUBQ #1,D0
- 56CE w, FFF6 w, \ DBNE D6,numloop
- 6706 w, \ endtst BEQ.S end
- 4E71 w, \ 2 NOPs resulting from patching!!
- 4E71 w, \
- 5388 w, \ SUBQ #1,A0
- 5246 w, \ end ADDQ.W #1,D6
- 2C86 w, \ MOVE D6,(SP)
- 2D03 w, \ PUSH D3
- 5389 w, \ SUBQ #1,A1
- 2209 w, \ MOVE A1,D1
- 4e71 w, \ 93CB w, \ SUB A3,A1 -> NOP
- 2D09 w, \ PUSH A1
- 91C1 w, \ SUB D1,A0
- 2D08 w, \ PUSH A0
- 4e75 w, \ RTS
-
- decimal
-
- false value LABEL_THERE? \ Set true if this line has a token at the
- \ start - i.e. a label. Used by main loop.
-
- : GETLINE { \ #chars ch -- }
- msg" getLine called"
- (Frefill) 0= ?error 154 \ Premature end of file
- bytesRead: topFile ++> charCount \ May be different to #TIB @
- #tib @ -> #chars
- 0 -> pos
- 1 ++> linect
- #chars
- IF
- tib c@ -> ch
- ch bl =
- IF false
- ELSE ch & ; =
- IF false
- ELSE ch & \ = IF false ELSE true THEN
- THEN
- THEN
- ELSE
- false
- THEN
- -> label_there? ;
-
-
- : RestOfLine \ ( -- addr len )
- tib pos + #tib @ pos - ;
-
-
- \ NEXTTOKEN puts the token into string Token and returns one of the following
- \ four token types:
- \ number, word, special, end-of-line
-
- : NEXTTOKEN { \ aa bb cc dd ee -- tokenType }
-
- \ Note: the locals are dummies to force regs to be saved over the
- \ ParseToken call!!
-
- clear: token
- storedToken
- NIF
- restOfLine parseToken put: token
- dup eol =
- IF
- 2drop eol
- ELSE
- swap ( # chars left ) #tib @ over - -> pos
- NIF eol -> storedToken THEN
- THEN
- ELSE
- storedToken
- 0 -> storedToken
- THEN
- uc: token 2drop ;
-